home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / techjock.arc / STRNGTTT.PAS < prev    next >
Pascal/Delphi Source File  |  1988-11-18  |  9KB  |  338 lines
  1. {$S-,R-,V-,D-,T-}
  2. {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
  3. {         TechnoJocks Turbo Toolkit v4.00            Released: Feb 1, 1988    }
  4. {                                                                             }
  5. {         Module: StrngTTT    --    string manipulation routines              }
  6. {                                                                             }
  7. {                       Copyright R. D. Ainsbury (c) 1986                     }
  8. {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
  9.  
  10. unit StrngTTT;
  11.  
  12. interface
  13.  
  14. Function PadLeft(Str:string;Size:byte;Pad:char):string;
  15. Function PadCenter(Str:string;Size:byte;Pad:char):string;
  16. Function PadRight(Str:string;Size:byte;Pad:char):string;
  17. Function Last(N:byte;Str:string):string;
  18. Function First(N:byte;Str:string):string;
  19. Function Upper(Str:string):string;
  20. Function Lower(Str:string):string;
  21. Function Proper(Str:string):string;
  22. Function OverType(N:byte;StrS,StrT:string):string;
  23. Function Strip(L,C:char;Str:string):string;
  24. Function LastPos(C:Char;Str:string):byte;
  25. Function PosWord(Wordno:byte;Str:string):byte;
  26. Function WordCnt(Str:string):byte;
  27. Function ExtractWords(StartWord,NoWords:byte;Str:string):string;
  28. Function Str_to_Int(Str:string):integer;
  29. Function Real_to_str(Number:real;Decimals:byte):string;
  30. Function Int_to_Str(Number:longint):string;
  31.  
  32. implementation
  33.  
  34. Function PadLeft(Str:string;Size:byte;Pad:char):string;
  35. var temp : string;
  36. begin
  37.     Fillchar(Temp[1],Size,Pad);
  38.     Temp[0] := chr(Size);
  39.     If Length(Str) <= Size then
  40.        Move(Str[1],Temp[1],length(Str))
  41.     else
  42.        Move(Str[1],Temp[1],size);
  43.     PadLeft := Temp;
  44. end;
  45.  
  46. Function PadCenter(Str:string;Size:byte;Pad:char):string;
  47. var temp : string;
  48. L : byte;
  49. begin
  50.     Fillchar(Temp[1],Size,Pad);
  51.     Temp[0] := chr(Size);
  52.     L := length(Str);
  53.     If L <= Size then
  54.        Move(Str[1],Temp[((Size - L) div 2) + 1],L)
  55.     else
  56.        Move(Str[((L - Size) div 2) + 1],Temp[1],Size);
  57.     PadCenter := temp;
  58. end; {center}
  59.  
  60. Function PadRight(Str:string;Size:byte;Pad:char):string;
  61. var
  62.   temp : string;
  63.   L : integer;
  64. begin
  65.     Fillchar(Temp[1],Size,Pad);
  66.     Temp[0] := chr(Size);
  67.     L := length(Str);
  68.     If L <= Size then
  69.        Move(Str[1],Temp[succ(Size - L)],L)
  70.     else
  71.        Move(Str[1],Temp[1],size);
  72.     PadRight := Temp;
  73. end;
  74.  
  75. Function Last(N:byte;Str:string):string;
  76. var Temp : string;
  77. begin
  78.     If N > length(Str) then
  79.        Temp := Str
  80.     else
  81.        Temp := copy(Str,succ(length(Str) - N),N);
  82.     Last := Temp;
  83. end;  {Func Last}
  84.  
  85. Function First(N:byte;Str:string):string;
  86. var Temp : string;
  87. begin
  88.     If N > length(Str) then
  89.        Temp := Str
  90.     else
  91.        Temp := copy(Str,1,N);
  92.     First := Temp;
  93. end;  {Func First}
  94.  
  95. Function Upper(Str:string):string;
  96. var
  97.   I : integer;
  98. begin
  99.     For I := 1 to length(Str) do
  100.         Str[I] := Upcase(Str[I]);
  101.     Upper := Str;
  102. end;  {Func Upper}
  103.  
  104. Function Lower(Str:string):string;
  105. var
  106.   I : integer;
  107. begin
  108.     For I := 1 to length(Str) do
  109.         If ord(Str[I]) in [65..90] then
  110.            Str[I] := chr(ord(Str[I]) + 32);
  111.     Lower := Str;
  112. end;  {Func Lower}
  113.  
  114. Function Proper(Str:string):string;
  115. var
  116.   I : integer;
  117.   SpaceBefore: boolean;
  118. begin
  119.     SpaceBefore := true;
  120.     Str := lower(Str);
  121.     For I := 1 to length(Str) do
  122.         If SpaceBefore and (ord(Str[I]) in [97..122]) then
  123.         begin
  124.             SpaceBefore := False;
  125.             Str[I] := Upcase(Str[I]);
  126.         end
  127.         else
  128.             If (SpaceBefore = False) and (Str[I] = ' ') then
  129.                 SpaceBefore := true;
  130.     Proper := Str;
  131. end;
  132.  
  133. Function OverType(N:byte;StrS,StrT:string):string;
  134. {Overlays StrS onto StrT at Pos N}
  135. var
  136.   L : byte;
  137.   StrN : string;
  138. begin
  139.     L := N + pred(length(StrS));
  140.     If L < length(StrT) then
  141.        L := length(StrT);
  142.     If L > 255 then
  143.        Overtype := copy(StrT,1,pred(N)) + copy(StrS,1,255-N)
  144.         else
  145.     begin
  146.        Fillchar(StrN[1],L,' ');
  147.        StrN[0] := chr(L);
  148.        Move(StrT[1],StrN[1],length(StrT));
  149.        Move(StrS[1],StrN[N],length(StrS));
  150.        OverType := StrN;
  151.     end;
  152. end;  {Func OverType}
  153.  
  154. Function Strip(L,C:char;Str:string):string;
  155. {L is left,center,right,all,ends}
  156. var I :  byte;
  157. begin
  158.     Case Upcase(L) of
  159.     'L' : begin       {Left}
  160.               While Str[1] = C do
  161.                     Delete(Str,1,1);
  162.           end;
  163.     'R' : begin       {Right}
  164.               While Str[length(Str)] = C do
  165.                     Delete(Str,length(Str),1);
  166.           end;
  167.     'B' : begin       {Both left and right}
  168.               While Str[1] = C do
  169.                     Delete(Str,1,1);
  170.               While Str[length(Str)] = C do
  171.                     Delete(Str,length(Str),1);
  172.           end;
  173.     'A' : begin       {All}
  174.               I := 1;
  175.               Repeat
  176.                    If Str[I] = C then
  177.                       Delete(Str,I,1)
  178.                    else
  179.                       I := succ(I);
  180.               Until (I > length(Str)) or (Str = '');
  181.           end;
  182.     end;
  183.     Strip := Str;
  184. end;  {Func Strip}
  185.  
  186. Function LastPos(C:Char;Str:string):byte;
  187. Var I : byte;
  188. begin
  189.     I := succ(Length(Str));
  190.     Repeat
  191.          I := Pred(I);
  192.     Until (I = 0) or (Str[I] = C);
  193.     LastPos := I;
  194. end;  {Func LastPos}
  195.  
  196. Function LocWord(StartAT,Wordno:byte;Str:string):byte;
  197. {local proc used by PosWord and Extract word}
  198. var
  199.   W,L: integer;
  200.   Spacebefore: boolean;
  201. begin
  202.     If (Str = '') or (wordno < 1) or (StartAT > length(Str)) then
  203.     begin
  204.         LocWord := 0;
  205.         exit;
  206.     end;
  207.     SpaceBefore := true;
  208.     W := 0;
  209.     L := length(Str);
  210.     StartAT := pred(StartAT);
  211.     While (W < Wordno) and (StartAT <= length(Str)) do
  212.     begin
  213.         StartAT := succ(StartAT);
  214.         If SpaceBefore and (Str[StartAT] <> ' ') then
  215.         begin
  216.             W := succ(W);
  217.             SpaceBefore := false;
  218.         end
  219.         else
  220.             If (SpaceBefore = false) and (Str[StartAT] = ' ') then
  221.                 SpaceBefore := true;
  222.     end;
  223.     If W = Wordno then
  224.        LocWord := StartAT
  225.     else
  226.        LocWord := 0;
  227. end;
  228.  
  229. Function PosWord(Wordno:byte;Str:string):byte;
  230. begin
  231.     PosWord := LocWord(1,wordno,Str);
  232. end;  {Func Word}
  233.  
  234. Function WordCnt(Str:string):byte;
  235. var
  236.   W,I: integer;
  237.   SpaceBefore: boolean;
  238. begin
  239.     If Str = '' then
  240.     begin
  241.         WordCnt := 0;
  242.         exit;
  243.     end;
  244.     SpaceBefore := true;
  245.     W := 0;
  246.     For  I :=  1 to length(Str) do
  247.     begin
  248.         If SpaceBefore and (Str[I] <> ' ') then
  249.         begin
  250.             W := succ(W);
  251.             SpaceBefore := false;
  252.         end
  253.         else
  254.             If (SpaceBefore = false) and (Str[I] = ' ') then
  255.                 SpaceBefore := true;
  256.     end;
  257.     WordCnt := W;
  258. end;
  259.  
  260. Function ExtractWords(StartWord,NoWords:byte;Str:string):string;
  261. var Start, finish : integer;
  262. begin
  263.     If Str = '' then
  264.     begin
  265.         ExtractWords := '';
  266.         exit;
  267.     end;
  268.     Start := LocWord(1,StartWord,Str);
  269.     If Start <> 0 then
  270.        finish := LocWord(Start,succ(NoWords),Str)
  271.     else
  272.     begin
  273.         ExtractWords := '';
  274.         exit;
  275.     end;
  276.     If finish <> 0 then
  277.        Repeat
  278.            finish := pred(finish);
  279.        Until Str[finish] <> ' '
  280.     else
  281.        finish := length(Str);
  282.     ExtractWords := copy(Str,Start,succ(finish-Start));
  283. end;  {Func ExtractWords}
  284.  
  285. Function Int_to_Str(Number:longint):string;
  286. var Temp : string;
  287. begin
  288.     Str(Number,temp);
  289.     Int_to_Str := temp;
  290. end;
  291.  
  292. Function Str_to_Real(Str:string):real;
  293. var temp,code : integer;
  294. begin
  295.     If length(Str) = 0 then
  296.        Str_to_Real := 0
  297.     else
  298.     begin
  299.         If Copy(Str,1,1)='.' Then
  300.            Str:='0'+Str;
  301.         If (Copy(Str,1,1)='-') and (Copy(Str,2,1)='.') Then
  302.            Insert('0',Str,2);
  303.         If Str[length(Str)] = '.' then
  304.            Delete(Str,length(Str),1);
  305.        val(Str,temp,code);
  306.        if code = 0 then
  307.           Str_to_Real := temp
  308.        else
  309.           Str_to_Real := 0;
  310.     end;
  311. end;
  312.  
  313. function Real_to_str(Number:real;Decimals:byte):string;
  314. var Temp : string;
  315. begin
  316.     Str(Number:20:Decimals,Temp);
  317.     repeat
  318.          If copy(Temp,1,1) = ' ' then delete(Temp,1,1);
  319.     until copy(temp,1,1) <> ' ';
  320.     Real_to_Str := Temp;
  321. end;
  322.  
  323. Function  Str_to_Int(Str:string):integer;
  324. var temp,code : integer;
  325. begin
  326.     If length(Str) = 0 then
  327.        Str_to_Int := 0
  328.     else
  329.     begin
  330.        val(Str,temp,code);
  331.        if code = 0 then
  332.           Str_to_Int := temp
  333.        else
  334.           Str_to_Int := 0;
  335.     end;
  336. end;
  337.  
  338. end.